The Geography of U.S. Covid Impact

H1: County Data

Using CDC Data set of county by county Hesitancy data

H2: Merging Hesitancy and Census Population Data

H3: Fauci with a headache, or …

fauchi

H3: Data Wrangling

Formatting then merging two data frames

my_data0 <- my_data %>%
  select(!c("Percent non-Hispanic Native Hawaiian/Pacific Islander", "FIPS Code"))%>%
  rename(region = State, subregion = `County Name`) %>%
  mutate(region = tolower(region), subregion = tolower(subregion))%>%
  rename(est_hesitant = "Estimated hesitant")%>%
  rename(est_strong_hesitant = "Estimated strongly hesitant")%>%
  rename(svi_cat = "SVI Category"  )%>%
  rename(svi = "Social Vulnerability Index (SVI)"  )%>%
  rename(pct_full_vaxed = "Percent adults fully vaccinated against COVID-19 as of 3/30/2021")

my_data0$subregion <- str_remove(my_data0$subregion, " county.*")
my_data0$subregion <- str_remove(my_data0$subregion, ",.*")


census0 <- census%>%
  mutate(subregion = gsub("\\.", "", subregion))%>%
  mutate(subregion = tolower(subregion))%>%
  mutate(region = gsub(".*, ", "",subregion)) %>% 
  mutate(subregion = gsub(", .*", "", subregion))%>%
  rename(pop_est = "2019_pop_est")
census0$subregion <- str_remove(census0$subregion, " county.*")

my_data0 <- my_data0 %>%
  inner_join(census0, by =c("subregion", "region"))
head(my_data0, 100)
## # A tibble: 100 x 15
##    subregion region est_hesitant est_strong_hesi…   svi svi_cat `Ability to han…
##    <chr>     <chr>         <dbl>            <dbl> <dbl> <chr>              <dbl>
##  1 barbour   alaba…         0.23             0.11 1     Very H…             0.89
##  2 baldwin   alaba…         0.2              0.1  0.22  Low Vu…             0.23
##  3 jackson   alaba…         0.24             0.12 0.570 Modera…             0.61
##  4 jefferson alaba…         0.2              0.1  0.66  High V…             0.47
##  5 talladega alaba…         0.23             0.11 0.87  Very H…             0.84
##  6 autauga   alaba…         0.22             0.1  0.44  Modera…             0.61
##  7 marengo   alaba…         0.24             0.12 0.76  High V…             0.84
##  8 crenshaw  alaba…         0.23             0.11 0.69  High V…             0.84
##  9 mobile    alaba…         0.22             0.11 0.75  High V…             0.62
## 10 russell   alaba…         0.23             0.11 0.91  Very H…             0.84
## # … with 90 more rows, and 8 more variables: `CVAC Category` <chr>,
## #   pct_full_vaxed <dbl>, `Percent Hispanic` <dbl>, `Percent non-Hispanic
## #   American Indian/Alaska Native` <dbl>, `Percent non-Hispanic Asian` <dbl>,
## #   `Percent non-Hispanic Black` <dbl>, `Percent non-Hispanic White` <dbl>,
## #   pop_est <dbl>

H2: Making the maps

H3: Code

Creating mapable data set

usa_counties <- map_data(map = "county", region = ".")

my_data0_map <- my_data0 %>%
  inner_join(usa_counties, by =c("subregion", "region"))

Mapping of hesitancy

ggplot(my_data0_map, aes(x = long, y = lat, group = group, fill = est_hesitant)) +
  geom_polygon(color = "white", size = 0.05) +
  theme_void() +
  coord_fixed(ratio = 1.3) +
  labs(fill = "Proportion of residents hesitant to be vaccinated") +
  theme(legend.position="bottom")+
  scale_fill_distiller(palette = "Spectral")

Mapping of strong hesitancy

ggplot(my_data0_map, aes(x = long, y = lat, group = group, fill = est_strong_hesitant)) +
  geom_polygon(color = "white", size = 0.05) +
  theme_void() +
  coord_fixed(ratio = 1.3) +
  labs(fill = "Proportion of residents hesitant to be vaccinated") +
  theme(legend.position="bottom")+
  scale_fill_distiller(palette = "Spectral")

H3: Hesitancy Map

H3: Strong Hesitancy Map

H2: Analysis of Maps

IDK yet but theres something about how state lines really impact fill. I ran a cluser analysis to see if I was making this trend up or not

Try out clustering

my_data0_map_cluster <- my_data0_map %>%
  select(est_hesitant, long, lat)


set.seed(15)
library(mclust)
## Package 'mclust' version 5.4.7
## Type 'citation("mclust")' for citing this R package in publications.
## 
## Attaching package: 'mclust'
## The following object is masked from 'package:maps':
## 
##     map
## The following object is masked from 'package:purrr':
## 
##     map
county_clusts <- my_data0_map_cluster %>%
  kmeans(centers = 48)%>%
  fitted("classes")%>%
  as.character()

my_data0_map_cluster <- my_data0_map_cluster %>% mutate(cluster = county_clusts)

my_data0_map_cluster %>% ggplot(aes(x = long, y = lat)) +
  geom_point(aes(color = cluster), alpha = 0.5)

How to make tabs

Bulleted list

You can make a bulleted list like this:

  • item 1
  • item 2
  • item 3

Numbered list

You can make a numbered list like this

  1. First thing I want to say
  2. Second thing I want to say
  3. Third thing I want to say

Including code and plots

You can embed code as normal, for example:

summary(cars)
##      speed           dist       
##  Min.   : 4.0   Min.   :  2.00  
##  1st Qu.:12.0   1st Qu.: 26.00  
##  Median :15.0   Median : 36.00  
##  Mean   :15.4   Mean   : 42.98  
##  3rd Qu.:19.0   3rd Qu.: 56.00  
##  Max.   :25.0   Max.   :120.00

Let’s clean up the format of that output:

Speed Distance
Min. : 4.0 Min. : 2.00
1st Qu.:12.0 1st Qu.: 26.00
Median :15.0 Median : 36.00
Mean :15.4 Mean : 42.98
3rd Qu.:19.0 3rd Qu.: 56.00
Max. :25.0 Max. :120.00

In a study from the 1920s, fifty cars were used to see how the speed of the car and the distance taken to stop were related. Speeds ranged between 4 and 25 mph. Distances taken to stop ranged between 2 and 120 feet, with the middle 50% falling between 26 and 56 feet.

You can also embed plots as normal, for example:

Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.